;;; Chris Baird <chris.j.baird@gmail.com> (and vk2cjb@gmail.com) wrote
;;; this some time during 2021-2022.
;;; Requires a VZ300 with the 6847's pin 30 grounded to enable the
;;; 128x96 monochrome mode.

;;; --------------------------------------------------------------------

            PROCESSOR Z80

TOPRAM      equ $B7FF
CURSOR      equ TOPRAM-2 ;screen cell location [0,511]
INTHOOK     equ CURSOR-2
ATTRIB      equ INTHOOK-1 ;0=normal, 255=reverse
SCROLL      equ ATTRIB-1  ;smooth or jump screen scrolling
TIMER	    equ SCROLL-2

;;; ----------------------------------------------------------------------
	    .org $7B00

	    call systeminit

reset:      ld hl, text
            ld (point), hl

main:       ld a, 24             ;anti-glitch attempt..
            ld hl, (point)
            ld a, (hl)
            or a
            jp z, reset
            inc hl
            ld (point), hl
            call putchar
            call delayframe
            jp main

point:      dw text

;;; --------------------------------------------------------------------
; This code came from an earlier project.. and bits of it are left around
;           jp putchar
;           jp getchar
;           jp getserialword
;           jp cls
;           jp hexout
;           jp hexwordout
;           jp decout
;           jp putstring
;           jp scroll
;           jp smoothscroll
;           jp smooth1
;           jp jumpscroll4
;           jp delayframe
;;; ----------------------------------------------------------------------

systeminit: ld a, 0
            ld (CURSOR), a
            ld (ATTRIB), a
            ld (CURSOR+1), a
            ld (TIMER), a
            ld (TIMER+1), a
            ld a, 0
            ld (SCROLL), a
            ld a, 8+16          ; black on white
            ld a, 8             ; black on green
            ld ($6800), a
            di
            ld hl, newirq
            ld ($787E), hl
            ld a, 195
            ld ($787D), a
            ei
            jp cls

newirq:     push hl
            ld hl, (TIMER)
            inc hl
            ld (TIMER), hl
            pop hl
            ret

;;; ----------------------------------------------------------------------
;;; ----------------------------------------------------------------------

            ;; TODO
	    ;; set cursor (x,y)

	    ;; top-level putchar()
		; move cursor up,down(w/ scroll),left,right(w/ scroll)
		; reverse on/off
		; set screen foreground colour (8 codes)
		; bitmap row-write (8 codes)
		; ? cursor xor
	    ;; store LASTCHAR .. use it to give state for functions

	    ;; plot(x,y) .. unplot(x,y)

            ;; 0-31  control codes?
            ;;          0       nop  (done)
            ;;          1       cls  (done)
            ;;          5       invert character (without bumping cursor) (done)
            ;;          3       reverse on        (done)
            ;;          4       reverse off       (done)
            ;;          8       backspace/del     (done)
            ;;          10      LF                (done)
            ;;          13      CR                (done)
            ;;          16      foreground black  (done)
            ;;          17      foreground red    (done)
            ;;          18      foreground green  (done)
            ;;          19      foreground yellow (done)
            ;;          20      foreground blue   (done)
            ;;          21      foreground magneta(done)
            ;;          22      foreground cyan   (done)
            ;;          23      foreground white  (done)
            ;; 32-95    printable    (done)
            ;; 96-127   ? (32)
            ;; 128-255  ?

putchar:    cp 32
            jr nc, contputchar

            or 0                ;null
            jr z, pc0

pc1:        cp 1                ;cls
            jr nz, pc3
            call cls
pc0:        ret

pc3:        cp 3                ;reverse on
            jr nz, pc4
            ld a, 255
            ld (ATTRIB), a
            ret

pc4:        cp 4                ;reverse off
            jr nz, pc5
            ld a, 0
            ld (ATTRIB), a
            ret

pc5:        cp 5                ;reverse current screen cell
            jr nz, pc8
            jp reversecursor

pc8:        cp 8                ;backspace
            jr nz, pc10         ;maybe left-scroll line?
            ld a, (CURSOR)      ;decrease cursor addr, but not too far..
            or 0
            jr z, pc8b
            dec a
pc8b:       ld (CURSOR), a
            ret

pc10:       cp 10              ;newline
            jr nz, pc13
            ;; increase cursor location to the next line (round up next 16th)
bump32:     ld a, (CURSOR)
            and 224             ;32col
            add a, 32
            ld (CURSOR), a
            ld a, (CURSOR+1)
            adc a, 0
            ld (CURSOR+1), a
            cp 2
            jr c, pc10b
            ld a, 224           ;480
            ld (CURSOR), a
            ld a, 1
            ld (CURSOR+1),a
            jp scroll
pc10b:      ret

pc13:       cp 13               ;carrage-return
            jr nz, contputchar
            ld a, (CURSOR)
            and 224             ;32col
            ld (CURSOR),a
            ret

contputchar:
            ;; get character bitmap address into IX
            ld l, a
            ld e, a
            xor a               ;ld a,0
            ld h, a
            ld d, a
            add hl, hl
            add hl, de
            add hl, hl          ;hl=a*6
            ex de, hl
            ld ix, charbits-192
            add ix, de          ;ix=&font4+(a*6)-(32*6)

            call cursoraddr4    ;get screen address into HL

            ld b, 6             ;prep for loops
            ld de, 16

            ld a, (CURSOR)     ; check which half to do..
            bit 0, a
            jr nz, writeright

writeleft:  ld a, (hl)
            and 15
            ld c, a
            ld a, (ATTRIB)
            xor (ix+0)
            xor 255
            and 240
            or c
            ld (hl), a
            add hl, de
            inc ix
            djnz writeleft
            ;;
            jr writecont

writeright: ld a, (hl)
            and 240
            ld c, a
            ld a,(ATTRIB)
            xor (ix+0)
            xor 255
            and 15
            or c
            ld (hl), a
            add hl, de
            inc ix
            djnz writeright
            ;;

writecont:  ld hl, (CURSOR)
            inc hl
            ld (CURSOR), hl
            ld a, h
            cp 2                ;>=512
            ret nz
            ld hl, 480
            ld (CURSOR), hl
            jr scroll


;;; ----------------------------------------------------------------------
;;; map character position into video memory address (8x8 mode)

;;; charactor position 0-191
;;; 00..0F -> 7000..700F
;;; 10..1F -> 7060..706F
;;; 20..2F -> 70C0..70CF
;;; 30..3F -> 7120..712F

cursoraddr4:
            push af
            push bc

            ld a, (CURSOR+1)
            ld b, a
            ld h, a
            ld a, (CURSOR)
            and 224
            ld c, a
            ld l, a
            add hl, bc
            add hl, bc

            ld a, (CURSOR)
            and 30
            rra
            or l
            ld l, a
            ld a, h
            add a, $70
            ld h, a

            pop bc
            pop af
            ret

;;; ----------------------------------------------------------------------
;;; smaller screen-orientated functions
;;;

VIDEORAM    equ $7000

cls:        ld a, 0
	    ld (CURSOR), a
	    ld (CURSOR+1), a
            ld (ATTRIB), a
	    ld b, a
            ld a, 255
	    ld hl, VIDEORAM
	    call cls2
cls4:       call cls2
cls2:       call cls1
cls1:       ld (hl), a
	    inc hl
	    djnz cls1
	    ret

	    ;;

scroll:     ld a, (SCROLL)
	    or 0
	    jr nz, jumpscroll

            ;;

smoothscroll:
            call smooth2
smooth4:    call smooth2
smooth2:    call smooth1
smooth1:    call delayframe
	    ld hl, VIDEORAM+16	;src
	    ld de, VIDEORAM     ;dest
	    ld bc, 1520
	    ldir
            ;; blank out the last line
	    ;; de = VIDEORAM+21520 at this point..
	    ld b, 16
blankline:  ld a, 255
smoo1:      ld (de), a
	    inc de
	    djnz smoo1
	    ret

	    ;;

jumpscroll: call delayframe
            ld hl, VIDEORAM+96
	    ld de, VIDEORAM
	    ld bc, 1440
	    ldir
	    ld b, 192
            ld a, 255
js4b:       ld (de), a
	    inc de
	    djnz js4b
	    ret


reversecursor:
            call cursoraddr4
            ld de, 16
            ld b, 6
            ld c, 15
            ld a, (CURSOR)
            bit 0, a
            jr nz, revcursor1
            ld c, 240

revcursor1: ld a, c
            xor (hl)
            ld (hl), a
            add hl, de
            djnz revcursor1
            ret

;;; ----------------------------------------------------------------------

delayframe: push af
            push bc
	    push hl
	    ld hl, TIMER
	    ld a, (hl)
df1:        cp (hl)
	    jr z, df1

;            ld bc, 600
;df2:        dec bc
;            ld a, b
;            or c
;            jp nz, df2
	    pop hl
            pop bc
	    pop af
	    ret

;;; ----------------------------------------------------------------------
;;; input in HL

hexwordout: push hl
	    ld a, h
	    call hexout
	    pop hl
	    ld a, l
	    ;; fallthru

hexout:	    push af
	    sra a
	    sra a
	    sra a
	    sra a
	    call hexot1
	    pop af
	    ;; fall-thru
hexot1:     and 15
            cp 10
            sbc a,$69
            daa
	    jp putchar

;;; ----------------------------------------------------------------------
;;; output hl as a decimal value

decout:     call hldiv10
            add a, 48
            push af
            call hldiv10
            add a, 48
            push af
            call hldiv10
            add a, 48
            push af
            call hldiv10
            add a, 48
            push af
            call hldiv10
            add a, 48

            ;; check if the first digit is a zero..
            cp 48
            jr z, dec1

            call putchar        ;10000s
            pop af              ;1000s
dec2:       call putchar
            pop af
dec3:       call putchar        ;100s
            pop af
dec4:       call putchar        ;10s
dec5:       pop af
            jp putchar          ;1s

dec1:       pop af              ;is 1000s zero?
            cp 48
            jr nz, dec2

            pop af              ;is 100s zero?
            cp 48
            jr nz, dec3

            pop af              ;is 10s zero?
            cp 48
            jr nz, dec4

            jr dec5             ;don't care if zero now..


;;; code lifted from the internet..
;;; Inputs:
;;;     HL
;;; Outputs:
;;;     HL is the quotient
;;;     A is the remainder
;;;     DE is not changed
;;;     BC is 10

hldiv10:    ld bc,$0D0A
            xor a
            add hl,hl
            rla
            add hl,hl
            rla
            add hl,hl
            rla

hldiv10b:   add hl,hl
            rla
            cp c
            jr c, hldiv10a
            sub c
            inc l
hldiv10a:   djnz hldiv10b
            ret


;;; ----------------------------------------------------------------------
;;; output null-terminated string in HL

putstring:  ld a, (hl)
            or a
            ret z
            push hl
            call putchar
            pop hl
            inc hl
            jr putstring

;;; ----------------------------------------------------------------------
;;; data stuff

charbits:
	    ;.include "font4.h"
	    .include "font4x6.asm"

;;; ----------------------------------------------------------------------

text:
            db "-------------------------------*"
            db "\n"
            db "2021 NOVEMBER 7 VK NATIONAL NEWS"
            db "BROADCAST ON VK1WIA THE BEST\n"
            db "NEWS YOU'LL GET ALL WEEK\n"
            db "\n"
            db "MATERIAL MAY BE REPRODUCED IN\n"
            db "WHOLE OR IN PART, IN ANY FORM, A"
            db "CREDIT TO WIANEWS WOULDN'T GO\n"
            db "ASTRAY...\n"
            db "\n"
            db "-------------------------------*"
            db "\n"
            db "WIA AFFILIATED CLUBS COORDINATOR"
            db "ANGELO VK2NWT AND A CALL TO\n"
            db "CLUBS.\n"
            db "\n"
            db "THANKS TO A WIA NATIONAL NEWS\n"
            db "LISTENER WE HAVE BEEN ADVISED,\n"
            db "AND TRIPLE CHECKED, THAT THE\n"
            db "2021 ROSEBUD RADIO FESTIVAL\n"
            db "ORGANISED BY SPARC HAS BEEN\n"
            db "CANCELLED SO DON'T POP ALONG\n"
            db "NOVEMBER 14. BUT ...A BRAND NEW\n"
            db "ADDITION TO THE SOCIAL SCENE AND"
            db "NOT MUCH PRIOR NOTICE IS THAT\n"
            db "THE GOLD COAST WILL BE HAVING A\n"
            db "HAMFEST THIS YEAR AND IT HAPPENS"
            db "SUNDAY NOVEMBER 21.\n"
            db "\n"
            db "WIA\n"
            db "\n"
            db "WIA MEETS WITH ACMA\n"
            db "DURING OCTOBER THE WIA MET WITH\n"
            db "THE ACMA TO DISCUSS SEVERAL\n"
            db "IMPORTANT TOPICS INCLUDING THE\n"
            db "NEW CLASS LICENCING PROPOSALS,\n"
            db "HOW THE APANSA (AUSTRALIAN\n"
            db "RADIATION PROTECTION AND NUCLEAR"
            db "SAFETY AGENCY) CRITERIA OF EMR\n"
            db "COMPLIANCE WILL INTEGRATE WITH\n"
            db "THE POTENTIALLY NEW AMATEUR\n"
            db "LICENCING STRUCTURE, SOME OF THE"
            db "FINER POINTS OF THE 2X1\n"
            db "CALLSIGNS AND THE FYSO (FIVE\n"
            db "YEAR SPECTRUM OUTLOOK) AND THE\n"
            db "EFFECTS IT WILL HAVE ON THE\n"
            db "AMATEUR RADIO COMMUNITY LONG\n"
            db "TERM.\n"
            db "  ACMA WELCOMED THE OPPORTUNITY\n"
            db "TO MEET WITH THE WIA AND WERE\n"
            db "ACCEPTING THAT THE PREVIOUS VERY"
            db "DETAILED SUBMISSION ON AMATEUR\n"
            db "LICENSING ARRANGEMENTS PROVIDED\n"
            db "THE ACMA WITH SIGNIFICANT DETAIL"
            db "AND KNOWLEDGE TO CONSIDER.\n"
            db "  WITH RESPECT TO AMATEUR\n"
            db "LICENCING ARRANGEMENTS, ACMA\n"
            db "ADVISE THAT THE SUBMISSION TO\n"
            db "THE ACMA AUTHORITY WAS ALMOST\n"
            db "COMPLETE AND WOULD GO FORWARD\n"
            db "SHORTLY. THE NEXT STEP ONCE\n"
            db "APPROVED IS TO PROCEED WITH A\n"
            db "RESPONSE TO SUBMISSIONS AND\n"
            db "SUGGESTED STEPS GOING FORWARD.\n"
            db "THIS WAS MOST LIKELY TO OCCUR\n"
            db "JAN/FEB 2022, A BUSY TIME FOR\n"
            db "BOTH WIA AND ACMA. ACMA ADVISED\n"
            db "THAT THE UPDATE ON CHANGES FOR\n"
            db "THE AMATEUR SERVICE RELATED TO\n"
            db "THE APANSA EME STANDARD ACMA\n"
            db "WOULD CONSIST OF THE INTENTION\n"
            db "TO LIFT THE CURRENT REQUIREMENTS"
            db "FROM THE APPARATUS LCD INTO THE\n"
            db "NEW REGULATORY FRAMEWORK. THERE\n"
            db "IS NO INTENTION TO IMPOSE ANY\n"
            db "ADDITIONAL BURDEN ON AMATEURS.\n"
            db "WIA FINDS THIS AS AN EXCEPTIONAL"
            db "APPROACH AS ANY CHANGES WOULD\n"
            db "ENTAIL A LARGE EDUCATIONAL\n"
            db "REQUIREMENT AND THAT EDUCATION\n"
            db "IN THIS AREA WOULD BE A\n"
            db "NECESSITY ANYWAY.\n"
            db "  THE 2X1 CONTEST CALLSIGNS HAVE"
            db "BEEN A GREAT SUCCESS AND ACMA IS"
            db "NOT CONSIDERING IMPOSING ANY\n"
            db "FURTHER OPERATING CONDITIONS. IT"
            db "WILL BE UP TO THE AMATEUR\n"
            db "COMMUNITY TO COME TO A CONSENSUS"
            db "THAT IS REFLECTIVE OF THE\n"
            db "INTERNATIONAL VIEW OF CONTESTING"
            db "CRITERIA AND APPROPRIATE USE OF\n"
            db "THE 2X1 CONTESTING CALLSIGNS.\n"
            db "  ACMA MENTIONED THAT THEY ARE\n"
            db "WORKING ON THE ASSIGNMENT\n"
            db "PROCESS FOR ASSIGNMENT OF\n"
            db "REPEATER AND BEACON APPARATUS\n"
            db "LICENCES. IT WAS ACKNOWLEDGED OF"
            db "THE WIAS ROLE IN INTERNATIONAL\n"
            db "BAND PLANS. DISCUSSIONS WITH\n"
            db "ACMA AND OTHER PARTIES ARE\n"
            db "ONGOING WITH THE WIA DEVELOPING\n"
            db "A FRAMEWORK DOCUMENT FOR COMMENT"
            db "AS A WAY OF PROGRESSING TO A\n"
            db "SUITABLE ARRANGEMENT. THE\n"
            db "OUTCOME AND DISCUSSIONS WERE\n"
            db "ROBUST AND THE WIA THANKED THE\n"
            db "ACMA FOR SCHEDULING THE WIA INTO"
            db "THEIR VERY BUSY SCHEDULE.\n"
            db "  A FULL REPORT WILL BE RELEASED"
            db "SHORTLY ON THE WIA WEBSITE.\n"
            db "\n"
            db "STOP PRESS: FIRST OFFICIAL USE\n"
            db "OF 2X1 CONTEST CALLSIGNS. MONDAY"
            db "1/10/21, WITH THE CQWW SSB\n"
            db "CONTEST NOW OVER IT WAS GREAT TO"
            db "SEE SO MANY NEW CONTEST\n"
            db "CALLSIGNS BEING USED FOR THE\n"
            db "FIRST TIME ALONG WITH MANY NEW\n"
            db "CONTESTERS TRYING OUT THIS\n"
            db "COMPETITIVE FACET OF AMATEUR\n"
            db "RADIO. AMC DELIVERED IN A TIMELY"
            db "FASHION, JUST IN TIME FOR THE\n"
            db "BIGGEST GLOBAL HF CONTEST ON THE"
            db "CALENDAR.\n"
            db "  THE RESPONSES FROM THE\n"
            db "INTERNATIONAL CONTESTING\n"
            db "COMMUNITY WAS VARIED FROM WHAT\n"
            db "IS THE REST OF YOUR SUFFIX TO\n"
            db "GREAT TO HEAR VK NOW HAS CONTEST"
            db "CALLSIGNS\n"
            db "  IT WILL TAKE SOME TIME FOR THE"
            db "2X1 TO BE LESS CONFUSING AS MANY"
            db "SEASONED CONTESTERS JUST KNOW\n"
            db "THAT VKS DON'T HAVE ANY SINGLE\n"
            db "LETTER SUFFIXES IN\n"
            db "CONTESTS...UNTIL NOW THAT IS.\n"
            db "  THREE OF YOUR WIA DIRECTORS,\n"
            db "WHO ARE ALSO ACTIVE CONTESTERS\n"
            db "HAVE 2X1 CONTEST CALLSIGNS. DID\n"
            db "YOU MANAGE TO LOG ONE OF THEM\n"
            db "OVER THE WEEKEND AND WERE\n"
            db "UNAWARE?\n"
            db "  IF YOU PARTICIPATED IN THE\n"
            db "CQWW CONTEST AND USED A 2X1\n"
            db "CALLSIGN, PLEASE SUBMIT YOUR\n"
            db "CONTEST LOG TO THE CQWW CONTEST\n"
            db "LOG UPLOAD LINK FOR COLLATION.\n"
            db "HTTPS://WWW.CQWW.COM/LOGCHECK/\n"
            db "YOU MAY EVEN WIN OR PLACE IN A\n"
            db "SECTION.\n"
            db "  THE WIA WOULD LIKE TO HEAR\n"
            db "YOUR THOUGHTS ON THE USE OF 2X1\n"
            db "CONTEST CALLSIGNS. PLEASE SEND\n"
            db "YOUR COMMENTS TO\n"
            db "NATIONALOFFICE@WIA.ORG.AU AND WE"
            db "WILL COLLATE AND PRESENT THEM TO"
            db "OUR READERS AND LISTENERS IN THE"
            db "NEAR FUTURE.\n"
            db "  73 FROM LEE MOYLE, VK3GK, WIA\n"
            db "VICE PRESIDENT AND NOT ONLY IN\n"
            db "TEXT BUT NEXT WEEK IN AUDIO JOIN"
            db "ME HERE ON WIA NATIONAL NEWS.\n"
            db "\n\n\n"
            db 0
.end

